Notes/Domino 6 and 7 Forum : Anti-Spam Techniqes

I've had a LOT of success with the following snippets of code that I've implemented in my organization. Since using the above methods, I've been able to cut down on the amount of spam by 98%. With almost near-perfect reliability and with zero cost, I'd say it's by far the most effective anti-spam techniqe available on most any major platform.

I've since updated the code to work with Notes 6.5 JunkMail folder.

For those that didn't catch my previous posting that I had for R6, here's what I did. I took some code from all over the place - a few good ideas here, a few there - and modified them to work better with my situation and my ISP. Since my ISP also does anti-spam checking and tags mail, I look for their tag as well as my own (I have multiple MX records for redunancy, so I can't always guarantee the black list site will be the same on all mail). I run an agent before new mail arrives (Yes, I know this isn't feasible for some larger shops, but I've yet to see a performance hit with 200+ users, so I can only guess that it'd take thousands of users before I'd have a big impact on the server - my opinion) and I have a whitelist function that allows users to add domains and/or e-mail addresses that can bypass the filter.

The user has two initial options - all mail goes to a specific folder (used to be "Spam", now with 6.5 I moved it to "JunkMail") or you can opt to have mail just deleted and moved to a 'holding database'. I choose the second option by default for some of the less-talented users, just to avoid a lot of headaches. The holding DB holds all the Spam for 2 weeks, then deletes it.

I also have a nightly agent running, looking for any mail in anyone's Spam (or now JunkMail) folder that's older than 2 weeks. It then pulls it out of the user's mail file and into that same holding DB.

You will notice the agent looking for two tags - the one you should be familiar with - $DNSBLSite - and another, X_RBL - the second is the one put in by my ISP when it finds that the incoming server is on one of the may lists (and the local lists they keep) available to the public. If you don't need more than one, just take out the OR statement (or leave it in, it's not going to hurt anything).

You will also need to modify the Calendar Profile to allow for the Whitelist function (as well as for the option as to if the user wants to just delete, or move Spam). Since you really can't post designs on this site, I'm happy to e-mail you a blank template with the stuff you need in it as I've modified it. Just e-mail me or respond here and I'll get it to you.

So without further delay, here's the code.

Agent #1 - run before new mail arrives.

Sub Initialize
Dim Session As NotesSession
Dim DB As NotesDatabase
Dim archiveDb As NotesDatabase
Dim doc As notesdocument
Dim docProfile As NotesDocument
Dim strAction As String
Dim strFolder As String
Set Session = New NotesSession
Set doc = Session.DocumentContext
If doc.HasItem("X_RBL") Or doc.HasItem("$DNSBLSite") Then
REM Current Mail is marked as Spam
Set DB = Session.CurrentDatabase
REM Get Mail Preferences with Spam Settings
Set docProfile = db.GetProfileDocument("CalendarProfile")
If Not docProfile Is Nothing Then
REM Check whether sender is listed in personal Whitelist
If Not IsInWhiteList(db, doc, docProfile) Then
REM Get selected Action
strAction = ""
If docProfile.HasItem("SpamOptionsTX") Then
strAction = docProfile.SpamOptionsTX(0)
End If
Select Case strAction
Case "Move" 'Move to a folder
Call doc.PutInFolder("($JunkMail)", True)
Call doc.RemoveFromFolder("($Inbox)")
Case "Remove"
Set archiveDb = New NotesDatabase(db.Server,"SpamMail.nsf")
If Not archiveDb.IsOpen Then
Call archiveDb.Create( "", "", True )
End If
Call doc.CopyToDatabase(archiveDb)
Call doc.RemovePermanently(True)
End Select
End If
End If
End If
End Sub

Agent #2 - check to see if the e-mail is in the users' whitelist

Function IsInWhiteList(DB As NotesDatabase, Doc As NotesDocument, docProfile As NotesDocument) As Integer
IsInWhiteList = False
Dim docWhiteList As NotesDocument
Dim strFrom As String
Dim strTemp As String
If doc.HasItem("SMTPOriginator") Then
strFrom = Ucase(doc.SMTPOriginator(0))
Else
REM This is not an SMTP Message
Exit Function
End If
If strFrom = "" Then
If doc.HasItem("From") Then
strFrom = Ucase(doc.From(0))
Else
REM Unable to determine the sender
Exit Function
End If
End If
Forall strAllowed In docProfile.SpamWhiteListTX
If strAllowed <> "" Then
REM WhiteList may contain complete mail addresses like 'John@domain.com' ....
If Instr(strAllowed, "@") > 0 Then
If Ucase(strAllowed) = strFrom Then
IsInWhiteList = True
Exit Forall
End If
Else
REM ... or just domain names like 'domain.com'
strTemp = Mid$(strFrom, Instr(strFrom, "@")+1)
If Ucase(strTemp) = Ucase(strAllowed) Then
IsInWhiteList = True
Exit Forall
End If
End If
End If
End Forall
End Function

Agent # 3 - used for "Add to whitelist" function (which is a Action choice from users' mail)

Const SpamWhiteList ="SpamWhiteListTX"
Const DNSBLSite = "$DNSBLSite"
Const KUABL = "X_RBL"

Sub Initialize
Dim Session As notessession
Dim DB As NotesDatabase
Dim coll As NotesDocumentCollection
Dim UIWs As NotesUIWorkspace
Dim UIDoc As NotesUIDocument
Dim doc As NotesDocument
Dim docProfile As NotesDocument
Dim intChoice As Integer
Dim strFrom As String
Dim strDomain As String
Dim item As NotesItem
Dim boolFound As Integer
Set Session = New NotesSession
Set DB = Session.CurrentDatabase
Set docProfile = db.GetProfileDocument("CalendarProfile")
If docProfile Is Nothing Then
Messagebox "There is currently no profile for your mailfile available. Please click 'Tools' 'Preferences' "+_
"to create a new profile.", 16, "Unable to find profile"
Exit Sub
End If
If docProfile.HasItem(SpamWhiteList) Then
Set item = docProfile.GetFirstItem(SpamWhitelist)
Else
Set item = New NotesItem(docProfile, SpamWhiteList, "")
End If
REM Agent may be called from view or UIDocument
Set coll = DB.UnprocessedDocuments
If coll.Count = 0 Then
Set UIWs = New NotesUIWorkspace
Set UIDoc = UIWs.CurrentDocument
If Not UIDoc Is Nothing Then
Set doc = UIDoc.Document
Set coll = Nothing
Call coll.AddDocument(doc)
End If
End If
If coll.Count = 0 Then
Messagebox "Please select the sender you want to add to your Spam Whitelist.", 64, "No documents selected"
Exit Sub
End If
Set doc = coll.GetFirstDocument
Do While Not doc Is Nothing
If Not doc.HasItem(DNSBLSite) Or doc.HasItem(KUABL) Then
Messagebox "The selected document is not flagged as Spam Message. Therefor it's not necessary to "+_
"add the sender to your Spam Whitelist.", 64, "No need to update Whitelist"
Else
If doc.HasItem("SMTPOriginator") Then
strFrom = doc.SMTPOriginator(0)
Else
strFrom = ""
End If
If strFrom = "" Then
If doc.HasItem("From") Then
strFrom = doc.From(0)
End If
End If
If strFrom = "" Then
Messagebox "The sender of the mail could not be identified with fields 'SMTPOriginator' and 'From'." +_
"Therefor it's not possible to add the sender to your Whitelist.", 16, "Sender not identified"
Else
strdomain = Mid$(strFrom, Instr(strFrom, "@")+1)
If strDomain = strFrom Then
intChoice = 7
Else
intChoice = Messagebox ("Instead of adding the single email address '"+strFrom+"' you may also add the "+_
"whole domain '"+strDomain+"'. This is quite convenient if the domain belongs to a business partner and "+_
"you often receive mails from different users within this domain '"+strDomain+"'."+Chr(10)+Chr(10)+_
"Click 'Yes' to add the domain to your whitelist."+Chr(10)+_
"Click 'No' to add the single email address to your whitelist."+Chr(10)+_
"Click 'Cancel' for no update.", 291, "Update Spam Whitelist")
Select Case intChoice
Case 6
REM Add Domain
strFrom = strDomain
Case 7
REM Add Single Address
Case Else
REM Cancel
Exit Sub
End Select
End If
boolFound = False
Forall strAllowed In item.Values
Select Case True
Case Ucase(strAllowed) = Ucase(strFrom)
boolFound = True
Messagebox "Sender '"+strFrom+"' is already listed in your Whitelist. ", 64, "No need to update Whitelist"
Exit Forall
Case Ucase(strAllowed) = Ucase(strDomain)
boolFound = True
Messagebox "Your Whitelist already contains an entry for Domain '"+strDomain+"'. As the sender '"+_
strFrom+"' also belongs to this domain it is not necessary to add this single emailaddress.", 64, _
"No need to update Whitelist"
Exit Forall
End Select
End Forall
If Not boolFound Then
Call Item.AppendToTextList(strFrom)
If docProfile.Save(False, False) Then
Messagebox "Address '"+strFrom+"' has been added to your Whitelist.", 64, "Whitelist updated"
Else
Messagebox "An error appeared while saving your updated whitelist. Please try again to update your "+_
"whitelist in some minutes. If the problem still appears please contact your Support.", 16, _
"Whitelist could not be updated!"
End If
End If
End If
End If
Set doc = coll.GetNextDocument(doc)
Loop
Print "Agent finished"
End Sub

As I said before, this isn't all my code. Some of it I got out of the Sandbox, some of it I had to write or modify myself. I should have documented more where I got everything from, but we'll just have to call that a shortcoming on my part.

Enjoy...

Carter Manucy